home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / pcl / src-16f.lha / compiler / sparc / debug.lisp < prev    next >
Encoding:
Text File  |  1992-02-25  |  4.0 KB  |  129 lines
  1. ;;; -*- Package: SPARC -*-
  2. ;;;
  3. ;;; **********************************************************************
  4. ;;; This code was written as part of the CMU Common Lisp project at
  5. ;;; Carnegie Mellon University, and has been placed in the public domain.
  6. ;;; If you want to use this code or any part of CMU Common Lisp, please contact
  7. ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
  8. ;;;
  9. (ext:file-comment
  10.   "$Header: debug.lisp,v 1.3 92/02/25 07:06:23 wlott Exp $")
  11. ;;;
  12. ;;; **********************************************************************
  13. ;;;
  14. ;;; Compiler support for the new whizzy debugger.
  15. ;;;
  16. ;;; Written by William Lott.
  17. ;;; 
  18. (in-package "SPARC")
  19.  
  20. (defknown di::current-sp () system-area-pointer (movable flushable))
  21. (defknown di::current-fp () system-area-pointer (movable flushable))
  22. (defknown di::stack-ref (system-area-pointer index) t (flushable))
  23. (defknown di::%set-stack-ref (system-area-pointer index t) t (unsafe))
  24. (defknown di::lra-code-header (t) t (movable flushable))
  25. (defknown di::function-code-header (t) t (movable flushable))
  26. (defknown di::make-lisp-obj ((unsigned-byte 32)) t (movable flushable))
  27. (defknown di::get-lisp-obj-address (t) (unsigned-byte 32) (movable flushable))
  28. (defknown di::function-word-offset (function) index (movable flushable))
  29.  
  30. (define-vop (debug-cur-sp)
  31.   (:translate di::current-sp)
  32.   (:policy :fast-safe)
  33.   (:results (res :scs (sap-reg)))
  34.   (:result-types system-area-pointer)
  35.   (:generator 1
  36.     (move res csp-tn)))
  37.  
  38. (define-vop (debug-cur-fp)
  39.   (:translate di::current-fp)
  40.   (:policy :fast-safe)
  41.   (:results (res :scs (sap-reg)))
  42.   (:result-types system-area-pointer)
  43.   (:generator 1
  44.     (move res cfp-tn)))
  45.  
  46. (define-vop (read-control-stack)
  47.   (:translate kernel:stack-ref)
  48.   (:policy :fast-safe)
  49.   (:args (sap :scs (sap-reg))
  50.      (offset :scs (any-reg)))
  51.   (:arg-types system-area-pointer positive-fixnum)
  52.   (:results (result :scs (descriptor-reg)))
  53.   (:result-types *)
  54.   (:generator 5
  55.     (inst ld result sap offset)))
  56.  
  57. (define-vop (write-control-stack)
  58.   (:translate kernel:%set-stack-ref)
  59.   (:policy :fast-safe)
  60.   (:args (sap :scs (sap-reg))
  61.      (offset :scs (any-reg))
  62.      (value :scs (descriptor-reg) :target result))
  63.   (:arg-types system-area-pointer positive-fixnum *)
  64.   (:results (result :scs (descriptor-reg)))
  65.   (:result-types *)
  66.   (:generator 5
  67.     (inst st value sap offset)
  68.     (move result value)))
  69.  
  70. (define-vop (code-from-mumble)
  71.   (:policy :fast-safe)
  72.   (:args (thing :scs (descriptor-reg)))
  73.   (:results (code :scs (descriptor-reg)))
  74.   (:temporary (:scs (non-descriptor-reg)) temp)
  75.   (:variant-vars lowtag)
  76.   (:generator 5
  77.     (let ((bogus (gen-label))
  78.       (done (gen-label)))
  79.       (loadw temp thing 0 lowtag)
  80.       (inst srl temp vm:type-bits)
  81.       (inst cmp temp)
  82.       (inst b :eq bogus)
  83.       (inst sll temp (1- (integer-length vm:word-bytes)))
  84.       (unless (= lowtag vm:other-pointer-type)
  85.     (inst add temp (- lowtag vm:other-pointer-type)))
  86.       (inst sub code thing temp)
  87.       (emit-label done)
  88.       (assemble (*elsewhere*)
  89.     (emit-label bogus)
  90.     (inst b done)
  91.     (move code null-tn)))))
  92.  
  93. (define-vop (code-from-lra code-from-mumble)
  94.   (:translate di::lra-code-header)
  95.   (:variant vm:other-pointer-type))
  96.  
  97. (define-vop (code-from-function code-from-mumble)
  98.   (:translate di::function-code-header)
  99.   (:variant vm:function-pointer-type))
  100.  
  101. (define-vop (make-lisp-obj)
  102.   (:policy :fast-safe)
  103.   (:translate di::make-lisp-obj)
  104.   (:args (value :scs (unsigned-reg) :target result))
  105.   (:arg-types unsigned-num)
  106.   (:results (result :scs (descriptor-reg)))
  107.   (:generator 1
  108.     (move result value)))
  109.  
  110. (define-vop (get-lisp-obj-address)
  111.   (:policy :fast-safe)
  112.   (:translate di::get-lisp-obj-address)
  113.   (:args (thing :scs (descriptor-reg) :target result))
  114.   (:results (result :scs (unsigned-reg)))
  115.   (:result-types unsigned-num)
  116.   (:generator 1
  117.     (move result thing)))
  118.  
  119.  
  120. (define-vop (function-word-offset)
  121.   (:policy :fast-safe)
  122.   (:translate di::function-word-offset)
  123.   (:args (fun :scs (descriptor-reg)))
  124.   (:results (res :scs (unsigned-reg)))
  125.   (:result-types positive-fixnum)
  126.   (:generator 5
  127.     (loadw res fun 0 function-pointer-type)
  128.     (inst srl res vm:type-bits)))
  129.